home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / borland / jnfb88.arc / KEYINT.ARC / ACCEL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-10-08  |  8.0 KB  |  253 lines
  1. PROGRAM Accel;
  2. USES Crt,Dos;
  3.   (* ======================================= *)
  4.   (* This program demonstrates a method for  *)
  5.   (* accelerating the motion of an arrow-key *)
  6.   (* controlled character on the screen.     *)
  7.   (* If a "direction" key is held down, the  *)
  8.   (* character moves in larger and larger    *)
  9.   (* jumps, up to a preset "Speed Limit".    *)
  10.   (* It's easy to set the SPEED back down to *)
  11.   (* 1 whenever a new direction is chosen -- *)
  12.   (* the catch is to reset it when the       *)
  13.   (* SAME direction key is RELEASED.         *)
  14.   (* ======================================= *)
  15. {=============}
  16. {BEGIN INCLUDE}
  17. {=============}
  18. CONST
  19.   KR : Boolean = False;{KeyReleased FLAG}
  20.   Kbd_Int = 9;
  21. VAR
  22.   Kbd_Vec, Exit_Vec : Pointer;
  23.  
  24.   {$I ERROR.INC}
  25.  
  26.   PROCEDURE CLI; INLINE($FA); {INLINE procedures are NICE!}
  27.   PROCEDURE STI; INLINE($FB);
  28.  
  29.   PROCEDURE INT9_ISR(_Flags, _CS, _IP, _AX, _BX, _CX, _DX,
  30.                      _SI, _DI, _DS, _ES, _BP:word);
  31.   INTERRUPT;
  32.   (* ======================================== *)
  33.   (* This procedure gets ahead of the normal  *)
  34.   (* interrupt 9 and checks if the current    *)
  35.   (* character is a KEYPRESS code or a KEY    *)
  36.   (* RELEASE -- if the latter, the typed      *)
  37.   (* constant "KR" is set to TRUE (= 1).      *)
  38.   (* ======================================== *)
  39.   BEGIN
  40.   Inline(
  41.     $9C/              {PUSHF        ;Save flags}
  42.     $E4/$60/          {IN   AL,$60  ;Read the keyboard port}
  43.     $A8/$80/          {TEST AL,$80  ;Is the high bit set?}
  44.     $74/$05/          {JZ   Press   ;If not, skip to "Press"}
  45.     $C6/$06/>KR/$01/  {MOV  BYTE PTR [>KR],+$01 ;If so, make KR TRUE}
  46. {Press:}
  47.     (* ============================ *)
  48.     (* CHAIN to the regular INT 9   *)
  49.     (* ============================ *)
  50.     $9D/              {POPF         ;Restore the flags}
  51.     $A1/>KBD_VEC+2/   {MOV  AX,[>KBD_VEC+2] ;Old vector seg to AX}
  52.     $8B/$1E/>KBD_VEC/ {MOV  BX,[>KBD_VEC]   ;Old vector ofs to BX}
  53.     $87/$5E/$0E/      {XCHG BX,[BP+$0E] ;Swap ofs w/ return address}
  54.     $87/$46/$10/      {XCHG AX,[BP+$10] ;Swap seg w/ return address}
  55.     $89/$EC/          {MOV  SP,BP ;UNDO procedure's entry code}
  56.     $5D/              {POP  BP}
  57.     $07/              {POP  ES}
  58.     $1F/              {POP  DS}
  59.     $5F/              {POP  DI}
  60.     $5E/              {POP  SI}
  61.     $5A/              {POP  DX}
  62.     $59/              {POP  CX}
  63.     $CB);             {RETF ;in effect, JMP to old vector}
  64.   END;
  65.  
  66.   FUNCTION KeyReleased : Boolean;
  67.   (* ================================ *)
  68.   (*  Returns the state of the flag   *)
  69.   (*  KR and resets it to FALSE       *)
  70.   (* ================================ *)
  71.   BEGIN
  72.     CLI; {Don't want it changing DURING this!}
  73.     KeyReleased := KR;
  74.     KR := False;
  75.     STI; {OK, can change now}
  76.   END;
  77. {=============}
  78. {END INCLUDE  }
  79. {=============}
  80.  
  81.  
  82.   PROCEDURE Do_Demo;
  83.   (* ======================================== *)
  84.   (* Here begins the DEMO procedure that uses *)
  85.   (* the ISR above.  It responds to the four  *)
  86.   (* arrows keys and to "U", "A", and "Q".    *)
  87.   (* Move around with the arrow keys for a    *)
  88.   (* while, and then hit "A" to engage the    *)
  89.   (* Accellator.  "U" will Unaccelerate the   *)
  90.   (* arrow keys, and "Q" is the signal to     *)
  91.   (* Quit.                                    *)
  92.   (* ======================================== *)
  93.  
  94.   CONST
  95.     UKey = #72;  {SCAN codes for the arrow keys}
  96.     DKey = #80;
  97.     LKey = #75;
  98.     RKey = #77;
  99.   TYPE
  100.     direction = (Up, Down, Left, Right);
  101.   VAR
  102.     CRow, CCol          : Byte;
  103.     accel               : Boolean;
  104.     CH, CH2, Last_Arrow : Char;
  105.     M, Speed            : Byte;
  106.   CONST
  107.     Speed_Limit = 8;
  108.     Mark        = #$E9;{theta character}
  109.     unmark      = #$20;{space character}
  110.     Arrows : SET OF Char = [UKey, DKey, LKey, RKey];
  111.  
  112.     PROCEDURE RevVideo;
  113.     BEGIN
  114.       TextColor(Black);
  115.       TextBackground(White);
  116.     END;
  117.  
  118.     PROCEDURE initialize;
  119.     BEGIN
  120.       TextBackground(black);
  121.       ClrScr;
  122.       RevVideo;
  123.       Write('    MOVE with 4 arrow keys.');
  124.       Write('  [A]ccel, [U]naccel, [Q]uit.');
  125.       Write('               Speed:   ');
  126.       TextBackground(Black);
  127.       TextColor(White);
  128.       Speed      := 1;
  129.       CRow       := 12;
  130.       CCol       := 40;
  131.       Last_Arrow := #0;
  132.       Accel      := False;
  133.     END;
  134.  
  135.     PROCEDURE PutAChar(co, ro, fore, back : Byte; CH : char);
  136.     (* ===================================== *)
  137.     (* At location (co,ro), write character  *)
  138.     (* CH with color specified by the fore-  *)
  139.     (* and background attributes.            *)
  140.     (* ===================================== *)
  141.     BEGIN
  142.       TextColor(fore);
  143.       TextBackground(back);
  144.       GoToXY(co, ro);
  145.       Write(CH);
  146.     END;
  147.  
  148.     PROCEDURE Move_Increment(D : direction);
  149.    (* ======================================= *)
  150.    (* Move the marker in the given direction  *)
  151.    (* by as many spaces as the current SPEED. *)
  152.    (* If we hit the edge, beep and set speed  *)
  153.    (* back to one.                            *)
  154.    (* ======================================= *)
  155.  
  156.       PROCEDURE beep;
  157.       BEGIN
  158.         Sound(1000); Delay(50);
  159.         Sound(2000); Delay(50);
  160.         NoSound;
  161.       END;
  162.  
  163.     BEGIN
  164.       {FIRST blank the old location }
  165.       PutAChar(CCol, CRow, white, black, unmark);
  166.       CASE D OF
  167.         Up    : CRow := CRow-1;
  168.         Down  : CRow := CRow+1;
  169.         Left  : CCol := CCol-1;
  170.         Right : CCol := CCol+1;
  171.       END;
  172.       IF CRow < 2  THEN
  173.         BEGIN CRow := 2;  speed := 1; beep; END;
  174.       IF CRow > 24 THEN
  175.         BEGIN CRow := 24; speed := 1; beep; END;
  176.       IF CCol < 1  THEN
  177.         BEGIN CCol := 1;  speed := 1; beep; END;
  178.       IF CCol > 80 THEN
  179.         BEGIN CCol := 80; speed := 1; beep; END;
  180.       {NOW mark the new location }
  181.       PutAChar(CCol, CRow, black, white, Mark);
  182.     END;
  183.  
  184.   BEGIN                       {procedure Do_Demo;}
  185.     Initialize;
  186.     PutAChar(CCol, CRow, black, white, Mark);
  187.     REPEAT
  188.       REPEAT
  189.         CH := #0; CH2 := #0;
  190.         REPEAT UNTIL KeyPressed OR KeyReleased;
  191.         IF KeyPressed THEN
  192.           BEGIN
  193.             CH := ReadKey;
  194.             IF (CH = #0) AND KeyPressed THEN
  195.               CH2 := ReadKey
  196.             ELSE CH := UpCase(CH);
  197.           END
  198.         ELSE  {A key was released}
  199.           speed := 0;
  200.       UNTIL ((CH IN ['A', 'U', 'Q']) OR (CH2 IN Arrows));
  201.       IF CH = #0 THEN
  202.         BEGIN
  203.           IF Accel THEN
  204.             IF CH2 = Last_Arrow THEN
  205.               BEGIN
  206.                 {Key CH2 is being held down --
  207.                  increase speed!}
  208.                 IF Speed < Speed_Limit THEN
  209.                   Speed := Speed+1;
  210.               END
  211.             ELSE Speed := 1
  212.           ELSE Speed := 1;
  213.           GoToXY(79, 1); Write(speed);
  214.           Last_Arrow := CH2;
  215.           CASE CH2 OF
  216.             UKey : FOR M := 1 TO speed DO
  217.                      Move_Increment(Up);
  218.             DKey : FOR M := 1 TO speed DO
  219.                      Move_Increment(Down);
  220.             LKey : FOR M := 1 TO speed DO
  221.                      Move_Increment(Left);
  222.             RKey : FOR M := 1 TO speed DO
  223.                      Move_Increment(Right);
  224.           END;
  225.         END
  226.       ELSE
  227.         CASE CH OF
  228.           'A' : BEGIN
  229.                   Accel := True;
  230.                   RevVideo;
  231.                   TextColor(Black+Blink);
  232.                   GoToXY(59, 1); Write('ACCELERATED');
  233.                 END;
  234.           'U' : BEGIN
  235.                   Accel := False;
  236.                   RevVideo;
  237.                   GoToXY(59, 1); Write('           ');
  238.                 END;
  239.           'Q' : ;
  240.         END;
  241.     UNTIL CH = 'Q';
  242.   END;
  243.  
  244. BEGIN
  245.   CheckBreak := TRUE;
  246.   GetIntVec(Kbd_Int, Kbd_Vec);   {save "old" INT9}
  247.   SetIntVec(Kbd_Int, @INT9_ISR); {install new}
  248.   Exit_Vec := ExitProc;          {save old ExitProc}
  249.   ExitProc := @My_Error;         {install new}
  250.   Do_Demo;                       {show yer stuff!}
  251.   {The interrupt vector gets RESTORED in the ExitProc}
  252. END.
  253.